home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENTRY.SWG / 0006_Generalize Input.pas < prev    next >
Pascal/Delphi Source File  |  1993-10-28  |  5KB  |  128 lines
  1. {===========================================================================
  2. Date: 10-02-93 (06:28)
  3. From: RANDALL WOODMAN
  4. Subj: Input
  5.  
  6. {->>>>GetString<<<<--------------------------------------------}
  7. {                                                              }
  8. { Filename : GETSTRIN.SRC -- Last Modified 7/14/88             }
  9. {                                                              }
  10. { This is a generalized string-input procedure.  It shows a    }
  11. { field between vertical bar characters at X,Y, with any       }
  12. { string value passed initially in XString left-justified in   }
  13. { the field.  The current state of XString when the user       }
  14. { presses Return is returned in XString.  The user can press   }
  15. { ESC and leave the passed value of XString undisturbed, even  }
  16. { if XString was altered prior to his pressing ESC.            }
  17. {                                                              }
  18. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  19. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  20. {--------------------------------------------------------------}
  21.  
  22. PROCEDURE GetString(    X,Y      : Integer;
  23.                     VAR XString  : String80;
  24.                         MaxLen   : Integer;
  25.                         Capslock : Boolean;
  26.                         Numeric  : Boolean;
  27.                         GetReal  : Boolean;
  28.                     VAR RValue   : Real;
  29.                     VAR IValue   : Integer;
  30.                     VAR Error    : Integer;
  31.                     VAR Escape   : Boolean);
  32.  
  33. VAR I,J        : Integer;
  34.     Ch         : Char;
  35.     Cursor     : Char;
  36.     Dot        : Char;
  37.     BLength    : Byte;
  38.     ClearIt    : String80;
  39.     Worker     : String80;
  40.     Printables : SET OF Char;
  41.     Lowercase  : SET OF Char;
  42.     Numerics   : SET OF Char;
  43.     CR         : Boolean;
  44.  
  45.  
  46. BEGIN
  47.   Printables := [' '..'}'];               { Init sets }
  48.   Lowercase  := ['a'..'z'];
  49.   IF GetReal THEN Numerics := ['-','.','0'..'9','E','e']
  50.     ELSE Numerics := ['-','0'..'9'];
  51.   Cursor := '_'; Dot := '.';
  52.   CR := False; Escape := False;
  53.   FillChar(ClearIt,SizeOf(ClearIt),'.');  { Fill the clear string  }
  54.   ClearIt[0] := Chr(MaxLen);              { Set clear string to MaxLen }
  55.  
  56.                                 { Convert numbers to string if required:  }
  57.   IF Numeric THEN               { Convert zero values to null string: }
  58.     IF (GetReal AND (RValue = 0.0)) OR
  59.        (NOT GetReal AND (IValue = 0)) THEN XString := ''
  60.     ELSE                        { Convert nonzero values to string equiv: }
  61.       IF GetReal THEN Str(RValue:MaxLen,XString)
  62.         ELSE Str(IValue:MaxLen,XString);
  63.  
  64.                                           { Truncate string value to MaxLen }
  65.   IF Length(XString) > MaxLen THEN XString[0] := Chr(MaxLen);
  66.   GotoXY(X,Y); Write('|',ClearIt,'|');    { Draw the field  }
  67.   GotoXY(X+1,Y); Write(XString);
  68.   IF Length(XString)<MaxLen THEN
  69.     BEGIN
  70.       GotoXY(X + Length(XString) + 1,Y);
  71.       Write(Cursor)                       { Draw the Cursor }
  72.     END;
  73.   Worker := XString;      { Fill work string with input string     }
  74.  
  75.   REPEAT                  { Until ESC or (CR) entered }
  76.                           { Wait here for keypress:   }
  77.     WHILE NOT KeyPressed DO BEGIN {NULL} END;
  78.     Ch := ReadKey;
  79.  
  80.     IF Ch IN Printables THEN              { If Ch is printable... }
  81.       IF Length(Worker) >= MaxLen THEN UhUh ELSE
  82.         IF Numeric AND (NOT (Ch IN Numerics)) THEN UhUh ELSE
  83.           BEGIN
  84.             IF Ch IN Lowercase THEN IF Capslock THEN Ch := Chr(Ord(Ch)-32);
  85.             Worker := CONCAT(Worker,Ch);
  86.             GotoXY(X+1,Y); Write(Worker);
  87.             IF Length(Worker) < MaxLen THEN Write(Cursor)
  88.           END
  89.     ELSE   { If Ch is NOT printable... }
  90.       CASE Ord(Ch) OF
  91.        8,127 : IF Length(Worker) <= 0 THEN UhUh ELSE
  92.                   BEGIN
  93.                     Delete(Worker,Length(Worker),1);
  94.                     GotoXY(X+1,Y); Write(Worker,Cursor);
  95.                     IF Length(Worker) < MaxLen-1 THEN Write(Dot);
  96.                   END;
  97.  
  98.        13 : CR := True;          { Carriage return }
  99.  
  100.        24 : BEGIN                { CTRL-X : Blank the field }
  101.               GotoXY(X+1,Y); Write(ClearIt);
  102.               Worker := '';      { Blank out work string }
  103.             END;
  104.  
  105.        27 : Escape := True;      { ESC }
  106.        ELSE UhUh                 { CASE ELSE }
  107.     END; { CASE }
  108.  
  109.   UNTIL CR OR Escape;            { Get keypresses until (CR) or }
  110.                                  { ESC pressed }
  111.   GotoXY(X + 1,Y); Write(ClearIt);
  112.   GotoXY(X + 1,Y); Write(Worker);
  113.   IF CR THEN                     { Don't update XString if ESC hit }
  114.     BEGIN
  115.       XString := Worker;
  116.       IF Numeric THEN            { Convert string to Numeric values }
  117.         CASE GetReal OF
  118.           True  : Val(Worker,RValue,Error);
  119.           False : Val(Worker,IValue,Error)
  120.         END { CASE }
  121.       ELSE
  122.         BEGIN
  123.           RValue := 0.0;
  124.           IValue := 0
  125.         END
  126.     END
  127. END;  { GETString }
  128.